(* ===================================================================== *)
(** Application boprezo : Utiliser bebop en reseau.
    
    boprezo peut servir de client (par defaut) ou de serveur ( -s ).
    Utilise avec l'option -w (ou -way), il devient une simple passerelle pour 
    connecter des ordinateurs ne pouvant instancier de serveurs visibles.

    @author Mathieu Barbin, Mehdi Bouaziz
    @version 1.0.* *)
(* ===================================================================== *)

(* ===================================================================== *)
(** <h2> Outils génériques de connections client-serveur </h2> *)
(* ===================================================================== *)

exception ConnectionImpossible
exception ConnectionRompue
exception ServeurIntrouvable

exception SigInt
exception Quit

(** permettre de demander la fermeture de la socket pour une reutilisation instantanee *)
let reuse_socket sock = Unix.setsockopt sock Unix.SO_REUSEADDR true

(** Adresse de socket en fonction d'un serveur et d'un port *)
let sockaddr_of_serveur_port (serveur, port) =
  let serveur_adr =
    try Unix.inet_addr_of_string serveur 
    with Failure("inet_addr_of_string") -> 
      try (Unix.gethostbyname serveur).Unix.h_addr_list.(0) 
      with Not_found -> 
	Printf.fprintf stderr "%s : serveur inconnu\n" serveur;
	raise ServeurIntrouvable
  in Unix.ADDR_INET(serveur_adr,port);;

(** Determine si le domaine est unix, ou internet, en lisant l'adresse *)
let domain_of = function
  | Unix.ADDR_UNIX _ -> Unix.PF_UNIX
  | _ -> Unix.PF_INET;;

let client_connection sockaddr client_fun =
  try
    let ic,oc = Unix.open_connection sockaddr in 
    let r = client_fun ic oc in
    (Unix.shutdown_connection ic; r)
  with
  | Unix.Unix_error(e, "connect", s) -> 
      Printf.fprintf stderr "%s, connect\n" (Unix.error_message e);
      flush stderr;
      raise ConnectionImpossible 
  | Unix.Unix_error(e, s, s') -> 
      Printf.fprintf stderr "%s, %s, %s\n" (Unix.error_message e) s s';
      flush stderr;
      raise ConnectionRompue 
  | e ->
      raise e
	(*   raise ConnectionRompue *)

(** Donner une chaine a partir d'une adresse de socket *)
let string_of_sockaddr = function
  | Unix.ADDR_UNIX s -> s
  | Unix.ADDR_INET (inet, i) -> 
      Printf.sprintf "(%s,%d)" (Unix.string_of_inet_addr inet) i;;

(** Etablir un server generique parametre par une fonction server_fun 
    La fonction tourne en boucle *)
let establish_server server_fun sockaddr =
  let domain = domain_of sockaddr in
  let sock = Unix.socket domain Unix.SOCK_STREAM 0 
  in Unix.bind sock sockaddr ; (* lier la socket a l'adresse *)
  Unix.listen sock 30; (* accepte 30 requete en meme temps au max *)
  reuse_socket sock; 
  while true do
    let (s, caller) = Unix.accept sock in (* attend un nouvel arrivant *)
    let fork1 = Unix.fork () in  (* dedoubler le process *)
    begin
      match fork1 with
	(* 0 : c'est le nouveau process : c'est john *)
	(* on ajoute une generation pour qu'init se charge du process bil qui sera orphelin *)
       | 0 -> let fork2 = Unix.fork () in
	(* on cree bil, le fils de john, le petit fils de bob *)
	 begin
	   if fork2 <> 0 then exit 0 ; (* on tue john le fils de bob, le pere de bil *) 
	   Printf.eprintf "\nReception : %s\n" (string_of_sockaddr caller); flush stderr;
	   (* Printf.printf "fork 2 : %d\n" fork2; flush stdout; *)
           let inchan = Unix.in_channel_of_descr s 
           and outchan = Unix.out_channel_of_descr s 
           in server_fun inchan outchan ;
	   try
             close_in inchan ;
             close_out outchan ;
             exit 0
	   with
	   | _ -> exit 1
	 end
	   (* id : c'est le process parent bob, qui attend que son enfant john meurt *)
	   (* mais qui se fiche de l'avenir de bil *)
       | id -> Unix.close s; ignore(Unix.waitpid [] id)
    end
  done ;;

(** Optenir l'adresse internet locale *)
let get_my_addr () =
  (Unix.gethostbyname(Unix.gethostname())).Unix.h_addr_list.(0) ;;

(** Lancer le server *)
let main_serveur port serv_fun =
  let mon_adresse = get_my_addr() 
  in 
  begin
    Printf.fprintf stderr "Ouverture du serveur : %s(%s), port :%d\n"
      (Unix.string_of_inet_addr mon_adresse) (Unix.gethostname ()) port; 
    flush stderr;
    establish_server serv_fun (Unix.ADDR_INET(mon_adresse, port))
  end

(* ===================================================================== *)

(* let _ = Unix.handle_unix_error main_serveur uppercase_service_3;; *)

(** <h2> Les fonction clients-serveurs de boprezo </h2>*)

exception NextServer

(* ===================================================================== *)
(** Le serveur bopway est spécial : il attend 2 clients qui doivent etre : 
    1 - le serveur distant.
    2 - Ensuite, il lance une boucle sur la reception de clients distants, mais ne peut en traiter
    qu'un seul à la fois. Voir le schéma d'utilisation de boprezo -way dans le manuel pour plus de 
    détail.
    Dans certains cas, on peut preciser une commande preferencielle avec la commande *)
(* ===================================================================== *)
let establish_bopway_server sockaddr command =
  let first_call = ref true in
  Sys.set_signal Sys.sigint (Sys.Signal_handle (fun _->raise Quit));
  try begin
    let domain = domain_of sockaddr in
    let sock = Unix.socket domain Unix.SOCK_STREAM 0 
    in 
    begin
      try
	Unix.bind sock sockaddr
      with
      | Unix.Unix_error (_, "bind", _) ->
	  Printf.fprintf stderr "Binding impossible (port utilise ?)\n"; flush stderr;
	  raise Quit
    end; (* lier la socket a l'adresse *)
    Unix.listen sock 30; (* accepte 30 requete en meme temps au max *)
    reuse_socket sock;
    Printf.fprintf stderr "Bopway est une passerelle entre un serveur et un client distant (proxy)"; flush stderr;
    while true do
      Sys.set_signal Sys.sigint (Sys.Signal_handle (fun _->raise Quit)); 
      let inchanserver, outchanserver, string_description_serveur =
	let new_server () =
	  Printf.fprintf stderr "\nBopway : en attente d'un serveur distant ..."; flush stderr;
	  let (sserver, callerserver) = Unix.accept sock in (* attend un nouveau serveur *)
	  Printf.fprintf stderr "\nReception du serveur distant : %s" (string_of_sockaddr callerserver); flush stderr;
	  ((Unix.in_channel_of_descr sserver), (Unix.out_channel_of_descr sserver), (string_of_sockaddr callerserver))
	in
	if !first_call 
	then
	  begin
	    match command with
	    | None -> first_call :=  false; new_server ()
	    | Some c -> first_call := false; let iic, ooc = Unix.open_process c in iic, ooc, c
	  end
	else (new_server ())
      in
      try
	Sys.set_signal Sys.sigint (Sys.Signal_handle (fun _->raise SigInt));
	while true do
	  Printf.fprintf stderr "\nBopway : en attente d'un client distant ..."; flush stderr;
	  let (sclient, callerclient) = Unix.accept sock in (* attend un nouveau client *)
	  Printf.printf "\nReception d'un client distant : %s\n" (string_of_sockaddr callerclient); flush stdout;
	  let inchanclient = Unix.in_channel_of_descr sclient 
	  and outchanclient = Unix.out_channel_of_descr sclient 
	  in
	  try
	    Printf.fprintf stderr "Routage bopway : [ %s <--> %s ] ..." string_description_serveur (string_of_sockaddr callerclient); flush stderr;
	    while true do
	      let demande = input_line inchanclient in
	      (try output_string outchanserver (demande^"\n"); flush outchanserver; 
	       with End_of_file -> (try Unix.shutdown sclient Unix.SHUTDOWN_ALL; (* close_in inchanclient; close_out outchanclient; *) with _ -> () ); raise NextServer); 
	      let reponse = 
		(try input_line inchanserver 
		 with End_of_file -> (try Unix.shutdown sclient Unix.SHUTDOWN_ALL; (* close_in inchanclient; close_out outchanclient;*) with _ -> () ); raise NextServer) in
	      output_string outchanclient (reponse^"\n");
	      flush outchanclient;
	    done;
	  with
	  | End_of_file -> (
	      try 
		Unix.shutdown sclient Unix.SHUTDOWN_ALL;
		(* close_in inchanclient;
		   close_out outchanclient;
		*)
	      with _ -> () )
	done
      with
      | NextServer -> ( try close_in inchanserver; close_out outchanserver; with _ -> () ) 
      | SigInt -> ()
	 (*
	   begin
	   ( try 
	   Unix.shutdown sserver Unix.SHUTDOWN_ALL;	
	  (*
	   close_in inchanserver;
	   close_out outchanserver;
	 *)
	    with _ -> () );
	   raise Quit
	    end
	 *)
    done
  end with
  | Quit -> Printf.fprintf stderr "\nBopway : quit\n"; flush stderr
;;
(* ===================================================================== *)

(* ===================================================================== *)
(** Le client telnet est mieux que le telnet de base unix : il est bi-threads 
    donc permet une conversation assymétrique *)
(* ===================================================================== *)
let boprezo_telnet_client ic oc =
  let send_fun () = 
    try
      while true do
	let line_in = input_line stdin in
	Printf.fprintf oc "%s\n" line_in; flush oc;
      done
    with
    | End_of_file -> ()
  and receive_fun () = 
    try
      while true do
	let line_out = input_line ic in
	Printf.fprintf stdout "%s\n" line_out; flush stdout
      done
    with
    | End_of_file -> ()
  in
  ignore (Thread.create send_fun ());
  receive_fun ()
(* ===================================================================== *)


exception Pipe01Error of string

(* ===================================================================== *)
(** La fonction client dans le cas de boprezo : le serveur est un circuit,
    on lui envoit un protocole 01 recu sur stdin, et on reecrit le resultat
    sur stdout. A ce niveau, on ne fait aucune verification. *)
(* ===================================================================== *)
let boprezo_client ic oc =
  try
    while true do
      let line_in = input_line stdin in
      Printf.fprintf oc "%s\n" line_in; flush oc;
      let line_out = input_line ic in
      Printf.fprintf stdout "%s\n" line_out; flush stdout
    done
  with
  | End_of_file -> ()
(* ===================================================================== *)

(* ===================================================================== *)
(** La fonction serveur dans le cas de boprezo : le serveur va creer des
    instances d'une application pipe01 dont on a donnée la commande.
    On recoit un protocole 01 sur ic, on transmet a l'application, 
    et on transfert la reponse dans oc. *)
(* ===================================================================== *)
let boprezo_serveur commande_lancement ic oc =
  Printf.fprintf stderr "Lancement d'une instance de '%s'\n" commande_lancement;
  flush stderr;
  let pin, pout = Unix.open_process commande_lancement in
  try
    while true do
      let line_in = input_line ic in
      Printf.fprintf pout "%s\n" line_in; flush pout;
      let line_out = input_line pin in
      Printf.fprintf oc "%s\n" line_out; flush oc
    done
  with
  | End_of_file -> ignore (Unix.close_process (pin, pout))
      (* on ne recoit plus de notre process par exemple *)
(* ===================================================================== *)

(** <h2> Executable boprezo en ligne de commandes </h2> *)

type execution = Serveur of t_serveur | Client of t_client | BopWay of (string option * infos) | Telnet of t_client
and infos =  
    { 
      port : int;
      options : string list
    }
and t_serveur = 
    {
      infos_s : infos;
      commande : string
    }
and t_client =
    {
      infos_c : infos;
      adresse : string;
    }

exception ArgumentsInvalides;;

let is_int s = try ignore(int_of_string s); true with Failure "int_of_string" -> false;;

let execution_of_sys_argv sys_argv =
  let len = Array.length sys_argv in
  try
    (* dans un premier temps : on observe les options avant -x *)
    let args, index_x = 
      let rec aux accu i =
	if i >= len
	then (accu, len)
	else 
	  if List.mem sys_argv.(i) ["-x"; "-exe"] 
	  then (accu, i)
	  else aux (sys_argv.(i)::accu) (succ i)
      in aux [] 1
    in 
    if (List.mem "-s" args) || (List.mem "-server" args)
    then
      begin 
	(* options du serveur : dans args uniquement *)
	let port, options =
	  let b_port = ref false in
	  let rec aux po opt = function
	    | [] -> po, opt
	    | t::q ->
		if String.length t > 1 && t.[0] = '-'
		then aux po (t::opt) q
		else
		  if is_int t
		  then 
		    if !b_port
		    then raise ArgumentsInvalides
		    else (b_port:=true; aux (int_of_string t) opt q)
		  else raise ArgumentsInvalides
	  in 
	  let res = aux 0 [] args
	  in
	  if not (!b_port)
	  then raise ArgumentsInvalides
	  else res
	in
	(* dans un deuxieme temps, la commande *)
	let commande = 
	  let rec aux accu i = 
	    if i >= len
	    then accu
	    else aux (accu^sys_argv.(i)^" ") (succ i)
	  in aux "" (index_x + 1)
	in
	if commande = ""
	then raise ArgumentsInvalides
	else
	  if (List.exists (fun t -> List.mem t ["-c"; "-w"; "-way"; "-t"; "-telnet"]) options) 
	  then raise ArgumentsInvalides
	  else 
	    Serveur { infos_s = { port = port; options = options}; commande = commande }
      end
    else
      if (List.mem "-w" args) || (List.mem "-way" args)
      then
	begin 
	    (* ce qui nous interresse est dans args uniquement *)
	  let port, options =
	    let b_port = ref false in
	    let rec aux po opt = function
	      | [] -> po, opt
	      | t::q ->
		  if String.length t > 1 && t.[0] = '-'
		  then aux po (t::opt) q
		  else
		    if is_int t
		    then 
		      if !b_port
		      then raise ArgumentsInvalides
		      else (b_port:=true; aux (int_of_string t) opt q)
		    else raise ArgumentsInvalides
	    in 
	    let res = aux 0 [] args
	    in
	    if not (!b_port)
	    then raise ArgumentsInvalides
	    else res 
	  in 
	  (* veut-on faire un bopway avec un serveur preferenciel ? *)
	  let commande =
	    let rec aux accu i =
	      if i >= len
	      then accu
	      else aux (accu^sys_argv.(i)^" ") (succ i)
	    in aux "" (index_x + 1)
	  in
	  if (List.exists (fun t -> List.mem t ["-s"; "-server"; "-c"; "-t"; "-telnet"]) options) 
	  then raise ArgumentsInvalides
	  else 
	    if commande = ""
	    then BopWay (None, { options = options; port = port})
	    else BopWay ((Some commande), {  options = options; port = port}) 
	end
      else
	if (List.mem "-t" args) || (List.mem "-telnet" args)
	then
	  begin
	    (* ce qui nous interresse est dans args uniquement *)
	    let adresse, port, options =
	      let b_adresse = ref false and b_port = ref false in
	      let rec aux ad po opt = function
		| [] -> ad, po, opt
		| t::q ->
		    if String.length t > 1 && t.[0] = '-'
		    then aux ad po (t::opt) q
		    else
		      if is_int t
		      then 
			if !b_port
			then raise ArgumentsInvalides
			else (b_port:=true; aux ad (int_of_string t) opt q)
		      else 
			if !b_adresse
			then raise ArgumentsInvalides
			else (b_adresse:=true; aux t po opt q)
	      in 
	      let res = aux "" 0 [] args
	      in
	      if not (!b_adresse && !b_port)
	      then raise ArgumentsInvalides
	      else res 
	    in 
	    if (List.exists (fun t -> List.mem t ["-s"; "-server"; "-x"; "-exe"; "-c"; "-w"; "-way"]) options) 
	    then raise ArgumentsInvalides
	    else Telnet { infos_c = {  options = options; port = port}; adresse = adresse }  
	  end
	else
	  (* On est dans le cas client *)
	  begin
	    (* ce qui nous interresse est dans args uniquement *)
	    let adresse, port, options =
	      let b_adresse = ref false and b_port = ref false in
	      let rec aux ad po opt = function
		| [] -> ad, po, opt
		| t::q ->
		    if String.length t > 1 && t.[0] = '-'
		    then aux ad po (t::opt) q
		    else
		      if is_int t
		      then 
			if !b_port
			then raise ArgumentsInvalides
			else (b_port:=true; aux ad (int_of_string t) opt q)
		      else 
			if !b_adresse
			then raise ArgumentsInvalides
			else (b_adresse:=true; aux t po opt q)
	      in 
	      let res = aux "" 0 [] args
	      in
	      if not (!b_adresse && !b_port)
	      then raise ArgumentsInvalides
	      else res 
	    in 
	    if (List.exists (fun t -> List.mem t ["-s"; "-server"; "-x"; "-exe"; "-w"; "-way"; "-t"; "-telnet"]) options) 
	    then raise ArgumentsInvalides
	    else Client { infos_c = {  options = options; port = port}; adresse = adresse } 
	  end
  with
  | ArgumentsInvalides ->
      Printf.fprintf stderr "server use : %s -s [options] PORT -x shell_command\n" sys_argv.(0);
      Printf.fprintf stderr "client use : %s [-c] [options] ADDRINET PORT\n" sys_argv.(0);
      Printf.fprintf stderr "bopway use : %s -w [options] PORT [-x shell_command] \n" sys_argv.(0); 
      Printf.fprintf stderr "telnet use : %s -t [options] ADDRINET PORT\n" sys_argv.(0);
      flush stderr;
      exit 1

;;

let _ =
  Message.message#thisis "boprezo";
  match execution_of_sys_argv Sys.argv with
  | Serveur se ->
      begin
	Unix.handle_unix_error (main_serveur se.infos_s.port) (boprezo_serveur se.commande)
      end
  | Client cl ->
      let sock = sockaddr_of_serveur_port (cl.adresse, cl.infos_c.port) in
      client_connection sock boprezo_client
  | Telnet cl ->
      let sock = sockaddr_of_serveur_port (cl.adresse, cl.infos_c.port) in
      client_connection sock boprezo_telnet_client
  | BopWay (commande, bw) ->
      let sock = (Unix.ADDR_INET (get_my_addr (), bw.port)) in
      establish_bopway_server sock commande
;;
